home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue34 / alfresco / trie.pas < prev    next >
Pascal/Delphi Source File  |  1998-04-21  |  4KB  |  134 lines

  1. {*********************************************************}
  2. {* Trie                                                  *}
  3. {* Copyright (c) Julian M Bucknall 1998                  *}
  4. {* All rights reserved.                                  *}
  5. {*********************************************************}
  6. {* A simple trie class                                   *}
  7. {*********************************************************}
  8.  
  9. {Note: this unit is released as freeware. In other words, you are free
  10.        to use this unit in your own applications, however I retain all
  11.        copyright to the code. JMB}
  12.  
  13. {$IFDEF VER80}
  14. !! Error
  15. This unit uses long strings only. In other words, you must be using
  16. Delphi 2 or later.
  17. {$ENDIF}
  18.  
  19. unit Trie;
  20.  
  21. interface
  22.  
  23. type
  24.   PTrieNode = ^TTrieNode;
  25.   TTrieNode = array [#0..#255] of PTrieNode;
  26.  
  27. type
  28.   TTrie = class
  29.     protected {private}
  30.       FRoot : PTrieNode;
  31.       FNodeCount : integer;
  32.     protected
  33.       procedure KillNodes(aRoot : PTrieNode);
  34.       function FindPrim(const S      : string;
  35.                           var aData  : pointer;
  36.                           var aNode  : PTrieNode;
  37.                           var aChPos : integer) : boolean;
  38.     public
  39.       constructor Create;
  40.       destructor Destroy; override;
  41.  
  42.       procedure AddObject(const S : string; aData : pointer);
  43.       function FindString(const S : string; var aData : pointer) : boolean;
  44.  
  45.       property NodeCount : integer read FNodeCount;
  46.   end;
  47.  
  48. implementation
  49.  
  50. {===TTrie============================================================}
  51. constructor TTrie.Create;
  52. begin
  53.   {allocate the root node}
  54.   New(FRoot);
  55.   FNodeCount := 1;
  56.   FillChar(FRoot^, sizeof(TTrieNode), 0);
  57. end;
  58. {--------}
  59. destructor TTrie.Destroy;
  60. begin
  61.   {destroy all nodes recursively}
  62.   KillNodes(FRoot);
  63. end;
  64. {--------}
  65. procedure TTrie.AddObject(const S : string; aData : pointer);
  66. var
  67.   DummyData : pointer;
  68.   Node      : PTrieNode;
  69.   NewNode   : PTrieNode;
  70.   ChPos     : integer;
  71.   i         : integer;
  72. begin
  73.   {if the string already exists, ignore the call}
  74.   if FindPrim(S, DummyData, Node, ChPos) then
  75.     Exit;
  76.   {now create a node for each remaining character in S}
  77.   for i := ChPos to length(S) do begin
  78.     New(NewNode);
  79.     inc(FNodeCount);
  80.     FillChar(NewNode^, sizeof(TTrieNode), 0);
  81.     Node^[S[i]] := NewNode;
  82.     Node := NewNode;
  83.   end;
  84.   {patch the terminator link to the given data}
  85.   Node^[#0] := aData;
  86. end;
  87. {--------}
  88. function TTrie.FindPrim(const S      : string;
  89.                           var aData  : pointer;
  90.                           var aNode  : PTrieNode;
  91.                           var aChPos : integer) : boolean;
  92. var
  93.   Node : PTrieNode;
  94.   i    : integer;
  95. begin
  96.   Node := FRoot;
  97.   for i := 1 to succ(length(S)) do begin
  98.     aNode := Node;
  99.     Node := Node^[S[i]];
  100.     if (Node = nil) then begin
  101.       Result := false;
  102.       aData := nil;
  103.       aChPos := i;
  104.       Exit;
  105.     end;
  106.   end;
  107.   Result := true;
  108.   aData := Node;
  109. end;
  110. {--------}
  111. function TTrie.FindString(const S : string; var aData : pointer) : boolean;
  112. var
  113.   DummyNode : PTrieNode;
  114.   DummyChPos: integer;
  115. begin
  116.   Result := FindPrim(S, aData, DummyNode, DummyChPos);
  117. end;
  118. {--------}
  119. procedure TTrie.KillNodes(aRoot : PTrieNode);
  120. var
  121.   Ch : char;
  122. begin
  123.   if (aRoot <> nil) then begin
  124.     {kill all children, recursively; ignore #0}
  125.     for Ch := #1 to #255 do
  126.       KillNodes(aRoot^[Ch]);
  127.     {kill root node}
  128.     Dispose(aRoot);
  129.   end;
  130. end;
  131. {====================================================================}
  132.  
  133. end.
  134.